home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 / Ham Radio 2000.iso / ham2000 / misc / dspice0s / evterm.c < prev    next >
C/C++ Source or Header  |  1992-11-21  |  2KB  |  98 lines
  1. /* evterm.f -- translated by f2c (version of 3 February 1990  3:36:42).
  2.    You must link the resulting object file with the libraries:
  3.     -lF77 -lI77 -lm -lc   (in that order)
  4. */
  5.  
  6. #include "f2c.h"
  7.  
  8. /*<       subroutine evterm(val,arg,iexp) >*/
  9. /* Subroutine */ int evterm_(val, arg, iexp)
  10. doublereal *val, *arg;
  11. integer *iexp;
  12. {
  13.     /* Builtin functions */
  14.     double log(), exp(), d_sign();
  15.  
  16.     /* Local variables */
  17.     static integer jexp;
  18.     static doublereal argexp;
  19.  
  20. /*<       implicit double precision (a-h,o-z) >*/
  21.  
  22. /*     this routine evaluates one term of a polynomial. */
  23.  
  24. /*<       jexp=iexp+1 >*/
  25.     jexp = *iexp + 1;
  26. /*<       if (jexp.ge.6) go to 60 >*/
  27.     if (jexp >= 6) {
  28.     goto L60;
  29.     }
  30. /*<       go to (10,20,30,40,50), jexp >*/
  31.     switch (jexp) {
  32.     case 1:  goto L10;
  33.     case 2:  goto L20;
  34.     case 3:  goto L30;
  35.     case 4:  goto L40;
  36.     case 5:  goto L50;
  37.     }
  38. /*<    10 val=1.0d0 >*/
  39. L10:
  40.     *val = 1.;
  41. /*<       go to 100 >*/
  42.     goto L100;
  43. /*<    20 val=arg >*/
  44. L20:
  45.     *val = *arg;
  46. /*<       go to 100 >*/
  47.     goto L100;
  48. /*<    30 val=arg*arg >*/
  49. L30:
  50.     *val = *arg * *arg;
  51. /*<       go to 100 >*/
  52.     goto L100;
  53. /*<    40 val=arg*arg*arg >*/
  54. L40:
  55.     *val = *arg * *arg * *arg;
  56. /*<       go to 100 >*/
  57.     goto L100;
  58. /*<    50 val=arg*arg >*/
  59. L50:
  60.     *val = *arg * *arg;
  61. /*<       val=val*val >*/
  62.     *val *= *val;
  63. /*<       go to 100 >*/
  64.     goto L100;
  65. /*<    60 if (arg.eq.0.0d0) go to 70 >*/
  66. L60:
  67.     if (*arg == 0.) {
  68.     goto L70;
  69.     }
  70. /*<       argexp=dble(iexp)*dlog(dabs(arg)) >*/
  71.     argexp = (doublereal) (*iexp) * log((abs(*arg)));
  72. /*<       if (argexp.lt.-200.0d0) go to 70 >*/
  73.     if (argexp < -200.) {
  74.     goto L70;
  75.     }
  76. /*<       val=dexp(argexp) >*/
  77.     *val = exp(argexp);
  78. /*<       if((iexp/2)*2.eq.iexp) go to 100 >*/
  79.     if (*iexp / 2 << 1 == *iexp) {
  80.     goto L100;
  81.     }
  82. /*<       val=dsign(val,arg) >*/
  83.     *val = d_sign(val, arg);
  84. /*<       go to 100 >*/
  85.     goto L100;
  86. /*<    70 val=0.0d0 >*/
  87. L70:
  88.     *val = 0.;
  89.  
  90. /*  finished */
  91.  
  92. /*<   100 return >*/
  93. L100:
  94.     return 0;
  95. /*<       end >*/
  96. } /* evterm_ */
  97.  
  98.